home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Pod / Checker.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  39.7 KB  |  1,272 lines
  1. #############################################################################
  2. # Pod/Checker.pm -- check pod documents for syntax errors
  3. #
  4. # Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.
  5. # This file is part of "PodParser". PodParser is free software;
  6. # you can redistribute it and/or modify it under the same terms
  7. # as Perl itself.
  8. #############################################################################
  9.  
  10. package Pod::Checker;
  11.  
  12. use vars qw($VERSION);
  13. $VERSION = "1.43_01";  ## Current version of this package
  14. require  5.005;    ## requires this Perl version or later
  15.  
  16. use Pod::ParseUtils; ## for hyperlinks and lists
  17.  
  18. =head1 NAME
  19.  
  20. Pod::Checker, podchecker() - check pod documents for syntax errors
  21.  
  22. =head1 SYNOPSIS
  23.  
  24.   use Pod::Checker;
  25.  
  26.   $syntax_okay = podchecker($filepath, $outputpath, %options);
  27.  
  28.   my $checker = new Pod::Checker %options;
  29.   $checker->parse_from_file($filepath, \*STDERR);
  30.  
  31. =head1 OPTIONS/ARGUMENTS
  32.  
  33. C<$filepath> is the input POD to read and C<$outputpath> is
  34. where to write POD syntax error messages. Either argument may be a scalar
  35. indicating a file-path, or else a reference to an open filehandle.
  36. If unspecified, the input-file it defaults to C<\*STDIN>, and
  37. the output-file defaults to C<\*STDERR>.
  38.  
  39. =head2 podchecker()
  40.  
  41. This function can take a hash of options:
  42.  
  43. =over 4
  44.  
  45. =item B<-warnings> =E<gt> I<val>
  46.  
  47. Turn warnings on/off. I<val> is usually 1 for on, but higher values
  48. trigger additional warnings. See L<"Warnings">.
  49.  
  50. =back
  51.  
  52. =head1 DESCRIPTION
  53.  
  54. B<podchecker> will perform syntax checking of Perl5 POD format documentation.
  55.  
  56. Curious/ambitious users are welcome to propose additional features they wish
  57. to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
  58. consistent with L<perlpod>.
  59.  
  60. The following checks are currently performed:
  61.  
  62. =over 4
  63.  
  64. =item *
  65.  
  66. Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences,
  67. and unterminated interior sequences.
  68.  
  69. =item *
  70.  
  71. Check for proper balancing of C<=begin> and C<=end>. The contents of such
  72. a block are generally ignored, i.e. no syntax checks are performed.
  73.  
  74. =item *
  75.  
  76. Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.
  77.  
  78. =item *
  79.  
  80. Check for same nested interior-sequences (e.g. 
  81. C<LE<lt>...LE<lt>...E<gt>...E<gt>>).
  82.  
  83. =item *
  84.  
  85. Check for malformed or non-existing entities C<EE<lt>...E<gt>>.
  86.  
  87. =item *
  88.  
  89. Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod>
  90. for details.
  91.  
  92. =item *
  93.  
  94. Check for unresolved document-internal links. This check may also reveal
  95. misspelled links that seem to be internal links but should be links
  96. to something else.
  97.  
  98. =back
  99.  
  100. =head1 DIAGNOSTICS
  101.  
  102. =head2 Errors
  103.  
  104. =over 4
  105.  
  106. =item * empty =headn
  107.  
  108. A heading (C<=head1> or C<=head2>) without any text? That ain't no
  109. heading!
  110.  
  111. =item * =over on line I<N> without closing =back
  112.  
  113. The C<=over> command does not have a corresponding C<=back> before the
  114. next heading (C<=head1> or C<=head2>) or the end of the file.
  115.  
  116. =item * =item without previous =over
  117.  
  118. =item * =back without previous =over
  119.  
  120. An C<=item> or C<=back> command has been found outside a
  121. C<=over>/C<=back> block.
  122.  
  123. =item * No argument for =begin
  124.  
  125. A C<=begin> command was found that is not followed by the formatter
  126. specification.
  127.  
  128. =item * =end without =begin
  129.  
  130. A standalone C<=end> command was found.
  131.  
  132. =item * Nested =begin's
  133.  
  134. There were at least two consecutive C<=begin> commands without
  135. the corresponding C<=end>. Only one C<=begin> may be active at
  136. a time.
  137.  
  138. =item * =for without formatter specification
  139.  
  140. There is no specification of the formatter after the C<=for> command.
  141.  
  142. =item * unresolved internal link I<NAME>
  143.  
  144. The given link to I<NAME> does not have a matching node in the current
  145. POD. This also happened when a single word node name is not enclosed in
  146. C<"">.
  147.  
  148. =item * Unknown command "I<CMD>"
  149.  
  150. An invalid POD command has been found. Valid are C<=head1>, C<=head2>,
  151. C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>,
  152. C<=for>, C<=pod>, C<=cut>
  153.  
  154. =item * Unknown interior-sequence "I<SEQ>"
  155.  
  156. An invalid markup command has been encountered. Valid are:
  157. C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, 
  158. C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, 
  159. C<ZE<lt>E<gt>>
  160.  
  161. =item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt>
  162.  
  163. Two nested identical markup commands have been found. Generally this
  164. does not make sense.
  165.  
  166. =item * garbled entity I<STRING>
  167.  
  168. The I<STRING> found cannot be interpreted as a character entity.
  169.  
  170. =item * Entity number out of range
  171.  
  172. An entity specified by number (dec, hex, oct) is out of range (1-255).
  173.  
  174. =item * malformed link LE<lt>E<gt>
  175.  
  176. The link found cannot be parsed because it does not conform to the
  177. syntax described in L<perlpod>.
  178.  
  179. =item * nonempty ZE<lt>E<gt>
  180.  
  181. The C<ZE<lt>E<gt>> sequence is supposed to be empty.
  182.  
  183. =item * empty XE<lt>E<gt>
  184.  
  185. The index entry specified contains nothing but whitespace.
  186.  
  187. =item * Spurious text after =pod / =cut
  188.  
  189. The commands C<=pod> and C<=cut> do not take any arguments.
  190.  
  191. =item * Spurious character(s) after =back
  192.  
  193. The C<=back> command does not take any arguments.
  194.  
  195. =back
  196.  
  197. =head2 Warnings
  198.  
  199. These may not necessarily cause trouble, but indicate mediocre style.
  200.  
  201. =over 4
  202.  
  203. =item * multiple occurrence of link target I<name>
  204.  
  205. The POD file has some C<=item> and/or C<=head> commands that have
  206. the same text. Potential hyperlinks to such a text cannot be unique then.
  207. This warning is printed only with warning level greater than one.
  208.  
  209. =item * line containing nothing but whitespace in paragraph
  210.  
  211. There is some whitespace on a seemingly empty line. POD is very sensitive
  212. to such things, so this is flagged. B<vi> users switch on the B<list>
  213. option to avoid this problem.
  214.  
  215. =begin _disabled_
  216.  
  217. =item * file does not start with =head
  218.  
  219. The file starts with a different POD directive than head.
  220. This is most probably something you do not want.
  221.  
  222. =end _disabled_
  223.  
  224. =item * previous =item has no contents
  225.  
  226. There is a list C<=item> right above the flagged line that has no
  227. text contents. You probably want to delete empty items.
  228.  
  229. =item * preceding non-item paragraph(s)
  230.  
  231. A list introduced by C<=over> starts with a text or verbatim paragraph,
  232. but continues with C<=item>s. Move the non-item paragraph out of the
  233. C<=over>/C<=back> block.
  234.  
  235. =item * =item type mismatch (I<one> vs. I<two>)
  236.  
  237. A list started with e.g. a bullet-like C<=item> and continued with a
  238. numbered one. This is obviously inconsistent. For most translators the
  239. type of the I<first> C<=item> determines the type of the list.
  240.  
  241. =item * I<N> unescaped C<E<lt>E<gt>> in paragraph
  242.  
  243. Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>>
  244. can potentially cause errors as they could be misinterpreted as
  245. markup commands. This is only printed when the -warnings level is
  246. greater than 1.
  247.  
  248. =item * Unknown entity
  249.  
  250. A character entity was found that does not belong to the standard
  251. ISO set or the POD specials C<verbar> and C<sol>.
  252.  
  253. =item * No items in =over
  254.  
  255. The list opened with C<=over> does not contain any items.
  256.  
  257. =item * No argument for =item
  258.  
  259. C<=item> without any parameters is deprecated. It should either be followed
  260. by C<*> to indicate an unordered list, by a number (optionally followed
  261. by a dot) to indicate an ordered (numbered) list or simple text for a
  262. definition list.
  263.  
  264. =item * empty section in previous paragraph
  265.  
  266. The previous section (introduced by a C<=head> command) does not contain
  267. any text. This usually indicates that something is missing. Note: A 
  268. C<=head1> followed immediately by C<=head2> does not trigger this warning.
  269.  
  270. =item * Verbatim paragraph in NAME section
  271.  
  272. The NAME section (C<=head1 NAME>) should consist of a single paragraph
  273. with the script/module name, followed by a dash `-' and a very short
  274. description of what the thing is good for.
  275.  
  276. =item * =headI<n> without preceding higher level
  277.  
  278. For example if there is a C<=head2> in the POD file prior to a
  279. C<=head1>.
  280.  
  281. =back
  282.  
  283. =head2 Hyperlinks
  284.  
  285. There are some warnings with respect to malformed hyperlinks:
  286.  
  287. =over 4
  288.  
  289. =item * ignoring leading/trailing whitespace in link
  290.  
  291. There is whitespace at the beginning or the end of the contents of 
  292. LE<lt>...E<gt>.
  293.  
  294. =item * (section) in '$page' deprecated
  295.  
  296. There is a section detected in the page name of LE<lt>...E<gt>, e.g.
  297. C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only.
  298. Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able
  299. to expand this to appropriate code. For links to (builtin) functions,
  300. please say C<LE<lt>perlfunc/mkdirE<gt>>, without ().
  301.  
  302. =item * alternative text/node '%s' contains non-escaped | or /
  303.  
  304. The characters C<|> and C</> are special in the LE<lt>...E<gt> context.
  305. Although the hyperlink parser does its best to determine which "/" is
  306. text and which is a delimiter in case of doubt, one ought to escape
  307. these literal characters like this:
  308.  
  309.   /     E<sol>
  310.   |     E<verbar>
  311.  
  312. =back
  313.  
  314. =head1 RETURN VALUE
  315.  
  316. B<podchecker> returns the number of POD syntax errors found or -1 if
  317. there were no POD commands at all found in the file.
  318.  
  319. =head1 EXAMPLES
  320.  
  321. See L</SYNOPSIS>
  322.  
  323. =head1 INTERFACE
  324.  
  325. While checking, this module collects document properties, e.g. the nodes
  326. for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>).
  327. POD translators can use this feature to syntax-check and get the nodes in
  328. a first pass before actually starting to convert. This is expensive in terms
  329. of execution time, but allows for very robust conversions.
  330.  
  331. Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>
  332. method to print errors and warnings. The summary output (e.g. 
  333. "Pod syntax OK") has been dropped from the module and has been included in
  334. B<podchecker> (the script). This allows users of B<Pod::Checker> to
  335. control completely the output behavior. Users of B<podchecker> (the script)
  336. get the well-known behavior.
  337.  
  338. =cut
  339.  
  340. #############################################################################
  341.  
  342. use strict;
  343. #use diagnostics;
  344. use Carp;
  345. use Exporter;
  346. use Pod::Parser;
  347.  
  348. use vars qw(@ISA @EXPORT);
  349. @ISA = qw(Pod::Parser);
  350. @EXPORT = qw(&podchecker);
  351.  
  352. use vars qw(%VALID_COMMANDS %VALID_SEQUENCES);
  353.  
  354. my %VALID_COMMANDS = (
  355.     'pod'    =>  1,
  356.     'cut'    =>  1,
  357.     'head1'  =>  1,
  358.     'head2'  =>  1,
  359.     'head3'  =>  1,
  360.     'head4'  =>  1,
  361.     'over'   =>  1,
  362.     'back'   =>  1,
  363.     'item'   =>  1,
  364.     'for'    =>  1,
  365.     'begin'  =>  1,
  366.     'end'    =>  1,
  367.     'encoding' => '1',
  368. );
  369.  
  370. my %VALID_SEQUENCES = (
  371.     'I'  =>  1,
  372.     'B'  =>  1,
  373.     'S'  =>  1,
  374.     'C'  =>  1,
  375.     'L'  =>  1,
  376.     'F'  =>  1,
  377.     'X'  =>  1,
  378.     'Z'  =>  1,
  379.     'E'  =>  1,
  380. );
  381.  
  382. # stolen from HTML::Entities
  383. my %ENTITIES = (
  384.  # Some normal chars that have special meaning in SGML context
  385.  amp    => '&',  # ampersand 
  386. 'gt'    => '>',  # greater than
  387. 'lt'    => '<',  # less than
  388.  quot   => '"',  # double quote
  389.  
  390.  # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
  391.  AElig    => 'Δ',  # capital AE diphthong (ligature)
  392.  Aacute    => '¡',  # capital A, acute accent
  393.  Acirc    => '¬',  # capital A, circumflex accent
  394.  Agrave    => '¿',  # capital A, grave accent
  395.  Aring    => '≈',  # capital A, ring
  396.  Atilde    => '√',  # capital A, tilde
  397.  Auml    => 'ƒ',  # capital A, dieresis or umlaut mark
  398.  Ccedil    => '«',  # capital C, cedilla
  399.  ETH    => '–',  # capital Eth, Icelandic
  400.  Eacute    => '…',  # capital E, acute accent
  401.  Ecirc    => ' ',  # capital E, circumflex accent
  402.  Egrave    => '»',  # capital E, grave accent
  403.  Euml    => 'À',  # capital E, dieresis or umlaut mark
  404.  Iacute    => 'Õ',  # capital I, acute accent
  405.  Icirc    => 'Œ',  # capital I, circumflex accent
  406.  Igrave    => 'Ã',  # capital I, grave accent
  407.  Iuml    => 'œ',  # capital I, dieresis or umlaut mark
  408.  Ntilde    => '—',  # capital N, tilde
  409.  Oacute    => '”',  # capital O, acute accent
  410.  Ocirc    => '‘',  # capital O, circumflex accent
  411.  Ograve    => '“',  # capital O, grave accent
  412.  Oslash    => 'ÿ',  # capital O, slash
  413.  Otilde    => '’',  # capital O, tilde
  414.  Ouml    => '÷',  # capital O, dieresis or umlaut mark
  415.  THORN    => 'fi',  # capital THORN, Icelandic
  416.  Uacute    => '⁄',  # capital U, acute accent
  417.  Ucirc    => '€',  # capital U, circumflex accent
  418.  Ugrave    => 'Ÿ',  # capital U, grave accent
  419.  Uuml    => '‹',  # capital U, dieresis or umlaut mark
  420.  Yacute    => '›',  # capital Y, acute accent
  421.  aacute    => '·',  # small a, acute accent
  422.  acirc    => '‚',  # small a, circumflex accent
  423.  aelig    => 'Ê',  # small ae diphthong (ligature)
  424.  agrave    => '‡',  # small a, grave accent
  425.  aring    => 'Â',  # small a, ring
  426.  atilde    => '„',  # small a, tilde
  427.  auml    => '‰',  # small a, dieresis or umlaut mark
  428.  ccedil    => 'Á',  # small c, cedilla
  429.  eacute    => 'È',  # small e, acute accent
  430.  ecirc    => 'Í',  # small e, circumflex accent
  431.  egrave    => 'Ë',  # small e, grave accent
  432.  eth    => '',  # small eth, Icelandic
  433.  euml    => 'Î',  # small e, dieresis or umlaut mark
  434.  iacute    => 'Ì',  # small i, acute accent
  435.  icirc    => 'Ó',  # small i, circumflex accent
  436.  igrave    => 'Ï',  # small i, grave accent
  437.  iuml    => 'Ô',  # small i, dieresis or umlaut mark
  438.  ntilde    => 'Ò',  # small n, tilde
  439.  oacute    => 'Û',  # small o, acute accent
  440.  ocirc    => 'Ù',  # small o, circumflex accent
  441.  ograve    => 'Ú',  # small o, grave accent
  442.  oslash    => '¯',  # small o, slash
  443.  otilde    => 'ı',  # small o, tilde
  444.  ouml    => 'ˆ',  # small o, dieresis or umlaut mark
  445.  szlig    => 'fl',  # small sharp s, German (sz ligature)
  446.  thorn    => '˛',  # small thorn, Icelandic
  447.  uacute    => '˙',  # small u, acute accent
  448.  ucirc    => '˚',  # small u, circumflex accent
  449.  ugrave    => '˘',  # small u, grave accent
  450.  uuml    => '¸',  # small u, dieresis or umlaut mark
  451.  yacute    => '˝',  # small y, acute accent
  452.  yuml    => 'ˇ',  # small y, dieresis or umlaut mark
  453.  
  454.  # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
  455.  copy   => '©',  # copyright sign
  456.  reg    => 'Æ',  # registered sign
  457.  nbsp   => "\240", # non breaking space
  458.  
  459.  # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
  460.  iexcl  => '°',
  461.  cent   => '¢',
  462.  pound  => '£',
  463.  curren => '§',
  464.  yen    => '•',
  465.  brvbar => '¶',
  466.  sect   => 'ß',
  467.  uml    => '®',
  468.  ordf   => '™',
  469.  laquo  => '´',
  470. 'not'   => '¨',    # not is a keyword in perl
  471.  shy    => '≠',
  472.  macr   => 'Ø',
  473.  deg    => '∞',
  474.  plusmn => '±',
  475.  sup1   => 'π',
  476.  sup2   => '≤',
  477.  sup3   => '≥',
  478.  acute  => '¥',
  479.  micro  => 'µ',
  480.  para   => '∂',
  481.  middot => '∑',
  482.  cedil  => '∏',
  483.  ordm   => '∫',
  484.  raquo  => 'ª',
  485.  frac14 => 'º',
  486.  frac12 => 'Ω',
  487.  frac34 => 'æ',
  488.  iquest => 'ø',
  489. 'times' => '◊',    # times is a keyword in perl
  490.  divide => '˜',
  491.  
  492. # some POD special entities
  493.  verbar => '|',
  494.  sol => '/'
  495. );
  496.  
  497. ##---------------------------------------------------------------------------
  498.  
  499. ##---------------------------------
  500. ## Function definitions begin here
  501. ##---------------------------------
  502.  
  503. sub podchecker( $ ; $ % ) {
  504.     my ($infile, $outfile, %options) = @_;
  505.     local $_;
  506.  
  507.     ## Set defaults
  508.     $infile  ||= \*STDIN;
  509.     $outfile ||= \*STDERR;
  510.  
  511.     ## Now create a pod checker
  512.     my $checker = new Pod::Checker(%options);
  513.  
  514.     ## Now check the pod document for errors
  515.     $checker->parse_from_file($infile, $outfile);
  516.  
  517.     ## Return the number of errors found
  518.     return $checker->num_errors();
  519. }
  520.  
  521. ##---------------------------------------------------------------------------
  522.  
  523. ##-------------------------------
  524. ## Method definitions begin here
  525. ##-------------------------------
  526.  
  527. ##################################
  528.  
  529. =over 4
  530.  
  531. =item C<Pod::Checker-E<gt>new( %options )>
  532.  
  533. Return a reference to a new Pod::Checker object that inherits from
  534. Pod::Parser and is used for calling the required methods later. The
  535. following options are recognized:
  536.  
  537. C<-warnings =E<gt> num>
  538.   Print warnings if C<num> is true. The higher the value of C<num>,
  539. the more warnings are printed. Currently there are only levels 1 and 2.
  540.  
  541. C<-quiet =E<gt> num>
  542.   If C<num> is true, do not print any errors/warnings. This is useful
  543. when Pod::Checker is used to munge POD code into plain text from within
  544. POD formatters.
  545.  
  546. =cut
  547.  
  548. ## sub new {
  549. ##     my $this = shift;
  550. ##     my $class = ref($this) || $this;
  551. ##     my %params = @_;
  552. ##     my $self = {%params};
  553. ##     bless $self, $class;
  554. ##     $self->initialize();
  555. ##     return $self;
  556. ## }
  557.  
  558. sub initialize {
  559.     my $self = shift;
  560.     ## Initialize number of errors, and setup an error function to
  561.     ## increment this number and then print to the designated output.
  562.     $self->{_NUM_ERRORS} = 0;
  563.     $self->{_NUM_WARNINGS} = 0;
  564.     $self->{-quiet} ||= 0;
  565.     # set the error handling subroutine
  566.     $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror');
  567.     $self->{_commands} = 0; # total number of POD commands encountered
  568.     $self->{_list_stack} = []; # stack for nested lists
  569.     $self->{_have_begin} = ''; # stores =begin
  570.     $self->{_links} = []; # stack for internal hyperlinks
  571.     $self->{_nodes} = []; # stack for =head/=item nodes
  572.     $self->{_index} = []; # text in X<>
  573.     # print warnings?
  574.     $self->{-warnings} = 1 unless(defined $self->{-warnings});
  575.     $self->{_current_head1} = ''; # the current =head1 block
  576.     $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings});
  577. }
  578.  
  579. ##################################
  580.  
  581. =item C<$checker-E<gt>poderror( @args )>
  582.  
  583. =item C<$checker-E<gt>poderror( {%opts}, @args )>
  584.  
  585. Internal method for printing errors and warnings. If no options are
  586. given, simply prints "@_". The following options are recognized and used
  587. to form the output:
  588.  
  589.   -msg
  590.  
  591. A message to print prior to C<@args>.
  592.  
  593.   -line
  594.  
  595. The line number the error occurred in.
  596.  
  597.   -file
  598.  
  599. The file (name) the error occurred in.
  600.  
  601.   -severity
  602.  
  603. The error level, should be 'WARNING' or 'ERROR'.
  604.  
  605. =cut
  606.  
  607. # Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
  608. sub poderror {
  609.     my $self = shift;
  610.     my %opts = (ref $_[0]) ? %{shift()} : ();
  611.  
  612.     ## Retrieve options
  613.     chomp( my $msg  = ($opts{-msg} || "")."@_" );
  614.     my $line = (exists $opts{-line}) ? " at line $opts{-line}" : "";
  615.     my $file = (exists $opts{-file}) ? " in file $opts{-file}" : "";
  616.     unless (exists $opts{-severity}) {
  617.        ## See if can find severity in message prefix
  618.        $opts{-severity} = $1  if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// );
  619.     }
  620.     my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : "";
  621.  
  622.     ## Increment error count and print message "
  623.     ++($self->{_NUM_ERRORS}) 
  624.         if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
  625.     ++($self->{_NUM_WARNINGS})
  626.         if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
  627.     unless($self->{-quiet}) {
  628.       my $out_fh = $self->output_handle() || \*STDERR;
  629.       print $out_fh ($severity, $msg, $line, $file, "\n")
  630.         if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
  631.     }
  632. }
  633.  
  634. ##################################
  635.  
  636. =item C<$checker-E<gt>num_errors()>
  637.  
  638. Set (if argument specified) and retrieve the number of errors found.
  639.  
  640. =cut
  641.  
  642. sub num_errors {
  643.    return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
  644. }
  645.  
  646. ##################################
  647.  
  648. =item C<$checker-E<gt>num_warnings()>
  649.  
  650. Set (if argument specified) and retrieve the number of warnings found.
  651.  
  652. =cut
  653.  
  654. sub num_warnings {
  655.    return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS};
  656. }
  657.  
  658. ##################################
  659.  
  660. =item C<$checker-E<gt>name()>
  661.  
  662. Set (if argument specified) and retrieve the canonical name of POD as
  663. found in the C<=head1 NAME> section.
  664.  
  665. =cut
  666.  
  667. sub name {
  668.     return (@_ > 1 && $_[1]) ?
  669.         ($_[0]->{-name} = $_[1]) : $_[0]->{-name};  
  670. }
  671.  
  672. ##################################
  673.  
  674. =item C<$checker-E<gt>node()>
  675.  
  676. Add (if argument specified) and retrieve the nodes (as defined by C<=headX>
  677. and C<=item>) of the current POD. The nodes are returned in the order of
  678. their occurrence. They consist of plain text, each piece of whitespace is
  679. collapsed to a single blank.
  680.  
  681. =cut
  682.  
  683. sub node {
  684.     my ($self,$text) = @_;
  685.     if(defined $text) {
  686.         $text =~ s/\s+$//s; # strip trailing whitespace
  687.         $text =~ s/\s+/ /gs; # collapse whitespace
  688.         # add node, order important!
  689.         push(@{$self->{_nodes}}, $text);
  690.         # keep also a uniqueness counter
  691.         $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
  692.         return $text;
  693.     }
  694.     @{$self->{_nodes}};
  695. }
  696.  
  697. ##################################
  698.  
  699. =item C<$checker-E<gt>idx()>
  700.  
  701. Add (if argument specified) and retrieve the index entries (as defined by
  702. C<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece
  703. of whitespace is collapsed to a single blank.
  704.  
  705. =cut
  706.  
  707. # set/return index entries of current POD
  708. sub idx {
  709.     my ($self,$text) = @_;
  710.     if(defined $text) {
  711.         $text =~ s/\s+$//s; # strip trailing whitespace
  712.         $text =~ s/\s+/ /gs; # collapse whitespace
  713.         # add node, order important!
  714.         push(@{$self->{_index}}, $text);
  715.         # keep also a uniqueness counter
  716.         $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
  717.         return $text;
  718.     }
  719.     @{$self->{_index}};
  720. }
  721.  
  722. ##################################
  723.  
  724. =item C<$checker-E<gt>hyperlink()>
  725.  
  726. Add (if argument specified) and retrieve the hyperlinks (as defined by
  727. C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line
  728. number and C<Pod::Hyperlink> object.
  729.  
  730. =back
  731.  
  732. =cut
  733.  
  734. # set/return hyperlinks of the current POD
  735. sub hyperlink {
  736.     my $self = shift;
  737.     if($_[0]) {
  738.         push(@{$self->{_links}}, $_[0]);
  739.         return $_[0];
  740.     }
  741.     @{$self->{_links}};
  742. }
  743.  
  744. ## overrides for Pod::Parser
  745.  
  746. sub end_pod {
  747.     ## Do some final checks and
  748.     ## print the number of errors found
  749.     my $self   = shift;
  750.     my $infile = $self->input_file();
  751.  
  752.     if(@{$self->{_list_stack}}) {
  753.         my $list;
  754.         while(($list = $self->_close_list('EOF',$infile)) &&
  755.           $list->indent() ne 'auto') {
  756.             $self->poderror({ -line => 'EOF', -file => $infile,
  757.                 -severity => 'ERROR', -msg => "=over on line " .
  758.                 $list->start() . " without closing =back" }); #"
  759.         }
  760.     }
  761.  
  762.     # check validity of document internal hyperlinks
  763.     # first build the node names from the paragraph text
  764.     my %nodes;
  765.     foreach($self->node()) {
  766.         $nodes{$_} = 1;
  767.         if(/^(\S+)\s+\S/) {
  768.             # we have more than one word. Use the first as a node, too.
  769.             # This is used heavily in perlfunc.pod
  770.             $nodes{$1} ||= 2; # derived node
  771.         }
  772.     }
  773.     foreach($self->idx()) {
  774.         $nodes{$_} = 3; # index node
  775.     }
  776.     foreach($self->hyperlink()) {
  777.         my ($line,$link) = @$_;
  778.         # _TODO_ what if there is a link to the page itself by the name,
  779.         # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">
  780.         if($link->node() && !$link->page() && $link->type() ne 'hyperlink') {
  781.             my $node = $self->_check_ptree($self->parse_text($link->node(),
  782.                 $line), $line, $infile, 'L');
  783.             if($node && !$nodes{$node}) {
  784.                 $self->poderror({ -line => $line || '', -file => $infile,
  785.                     -severity => 'ERROR',
  786.                     -msg => "unresolved internal link '$node'"});
  787.             }
  788.         }
  789.     }
  790.  
  791.     # check the internal nodes for uniqueness. This pertains to
  792.     # =headX, =item and X<...>
  793.     if($self->{-warnings} && $self->{-warnings}>1) {
  794.       foreach(grep($self->{_unique_nodes}->{$_} > 1,
  795.         keys %{$self->{_unique_nodes}})) {
  796.           $self->poderror({ -line => '-', -file => $infile,
  797.             -severity => 'WARNING',
  798.             -msg => "multiple occurrence of link target '$_'"});
  799.       }
  800.     }
  801.  
  802.     # no POD found here
  803.     $self->num_errors(-1) if($self->{_commands} == 0);
  804. }
  805.  
  806. # check a POD command directive
  807. sub command { 
  808.     my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
  809.     my ($file, $line) = $pod_para->file_line;
  810.     ## Check the command syntax
  811.     my $arg; # this will hold the command argument
  812.     if (! $VALID_COMMANDS{$cmd}) {
  813.        $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
  814.                          -msg => "Unknown command '$cmd'" });
  815.     }
  816.     else { # found a valid command
  817.         $self->{_commands}++; # delete this line if below is enabled again
  818.  
  819.         ##### following check disabled due to strong request
  820.         #if(!$self->{_commands}++ && $cmd !~ /^head/) {
  821.         #    $self->poderror({ -line => $line, -file => $file,
  822.         #         -severity => 'WARNING', 
  823.         #         -msg => "file does not start with =head" });
  824.         #}
  825.  
  826.         # check syntax of particular command
  827.         if($cmd eq 'over') {
  828.             # check for argument
  829.             $arg = $self->interpolate_and_check($paragraph, $line,$file);
  830.             my $indent = 4; # default
  831.             if($arg && $arg =~ /^\s*(\d+)\s*$/) {
  832.                 $indent = $1;
  833.             }
  834.             # start a new list
  835.             $self->_open_list($indent,$line,$file);
  836.         }
  837.         elsif($cmd eq 'item') {
  838.             # are we in a list?
  839.             unless(@{$self->{_list_stack}}) {
  840.                 $self->poderror({ -line => $line, -file => $file,
  841.                      -severity => 'ERROR', 
  842.                      -msg => "=item without previous =over" });
  843.                 # auto-open in case we encounter many more
  844.                 $self->_open_list('auto',$line,$file);
  845.             }
  846.             my $list = $self->{_list_stack}->[0];
  847.             # check whether the previous item had some contents
  848.             if(defined $self->{_list_item_contents} &&
  849.               $self->{_list_item_contents} == 0) {
  850.                 $self->poderror({ -line => $line, -file => $file,
  851.                      -severity => 'WARNING', 
  852.                      -msg => "previous =item has no contents" });
  853.             }
  854.             if($list->{_has_par}) {
  855.                 $self->poderror({ -line => $line, -file => $file,
  856.                      -severity => 'WARNING', 
  857.                      -msg => "preceding non-item paragraph(s)" });
  858.                 delete $list->{_has_par};
  859.             }
  860.             # check for argument
  861.             $arg = $self->interpolate_and_check($paragraph, $line, $file);
  862.             if($arg && $arg =~ /(\S+)/) {
  863.                 $arg =~ s/[\s\n]+$//;
  864.                 my $type;
  865.                 if($arg =~ /^[*]\s*(\S*.*)/) {
  866.                   $type = 'bullet';
  867.                   $self->{_list_item_contents} = $1 ? 1 : 0;
  868.                   $arg = $1;
  869.                 }
  870.                 elsif($arg =~ /^\d+\.?\s*(\S*)/) {
  871.                   $type = 'number';
  872.                   $self->{_list_item_contents} = $1 ? 1 : 0;
  873.                   $arg = $1;
  874.                 }
  875.                 else {
  876.                   $type = 'definition';
  877.                   $self->{_list_item_contents} = 1;
  878.                 }
  879.                 my $first = $list->type();
  880.                 if($first && $first ne $type) {
  881.                     $self->poderror({ -line => $line, -file => $file,
  882.                        -severity => 'WARNING', 
  883.                        -msg => "=item type mismatch ('$first' vs. '$type')"});
  884.                 }
  885.                 else { # first item
  886.                     $list->type($type);
  887.                 }
  888.             }
  889.             else {
  890.                 $self->poderror({ -line => $line, -file => $file,
  891.                      -severity => 'WARNING', 
  892.                      -msg => "No argument for =item" });
  893.         $arg = ' '; # empty
  894.                 $self->{_list_item_contents} = 0;
  895.             }
  896.             # add this item
  897.             $list->item($arg);
  898.             # remember this node
  899.             $self->node($arg);
  900.         }
  901.         elsif($cmd eq 'back') {
  902.             # check if we have an open list
  903.             unless(@{$self->{_list_stack}}) {
  904.                 $self->poderror({ -line => $line, -file => $file,
  905.                          -severity => 'ERROR', 
  906.                          -msg => "=back without previous =over" });
  907.             }
  908.             else {
  909.                 # check for spurious characters
  910.                 $arg = $self->interpolate_and_check($paragraph, $line,$file);
  911.                 if($arg && $arg =~ /\S/) {
  912.                     $self->poderror({ -line => $line, -file => $file,
  913.                          -severity => 'ERROR', 
  914.                          -msg => "Spurious character(s) after =back" });
  915.                 }
  916.                 # close list
  917.                 my $list = $self->_close_list($line,$file);
  918.                 # check for empty lists
  919.                 if(!$list->item() && $self->{-warnings}) {
  920.                     $self->poderror({ -line => $line, -file => $file,
  921.                          -severity => 'WARNING', 
  922.                          -msg => "No items in =over (at line " .
  923.                          $list->start() . ") / =back list"}); #"
  924.                 }
  925.             }
  926.         }
  927.         elsif($cmd =~ /^head(\d+)/) {
  928.             my $hnum = $1;
  929.             $self->{"_have_head_$hnum"}++; # count head types
  930.             if($hnum > 1 && !$self->{"_have_head_".($hnum -1)}) {
  931.               $self->poderror({ -line => $line, -file => $file,
  932.                    -severity => 'WARNING', 
  933.                    -msg => "=head$hnum without preceding higher level"});
  934.             }
  935.             # check whether the previous =head section had some contents
  936.             if(defined $self->{_commands_in_head} &&
  937.               $self->{_commands_in_head} == 0 &&
  938.               defined $self->{_last_head} &&
  939.               $self->{_last_head} >= $hnum) {
  940.                 $self->poderror({ -line => $line, -file => $file,
  941.                      -severity => 'WARNING', 
  942.                      -msg => "empty section in previous paragraph"});
  943.             }
  944.             $self->{_commands_in_head} = -1;
  945.             $self->{_last_head} = $hnum;
  946.             # check if there is an open list
  947.             if(@{$self->{_list_stack}}) {
  948.                 my $list;
  949.                 while(($list = $self->_close_list($line,$file)) &&
  950.                   $list->indent() ne 'auto') {
  951.                     $self->poderror({ -line => $line, -file => $file,
  952.                          -severity => 'ERROR', 
  953.                          -msg => "=over on line ". $list->start() .
  954.                          " without closing =back (at $cmd)" });
  955.                 }
  956.             }
  957.             # remember this node
  958.             $arg = $self->interpolate_and_check($paragraph, $line,$file);
  959.             $arg =~ s/[\s\n]+$//s;
  960.             $self->node($arg);
  961.             unless(length($arg)) {
  962.                 $self->poderror({ -line => $line, -file => $file,
  963.                      -severity => 'ERROR', 
  964.                      -msg => "empty =$cmd"});
  965.             }
  966.             if($cmd eq 'head1') {
  967.                 $self->{_current_head1} = $arg;
  968.             } else {
  969.                 $self->{_current_head1} = '';
  970.             }
  971.         }
  972.         elsif($cmd eq 'begin') {
  973.             if($self->{_have_begin}) {
  974.                 # already have a begin
  975.                 $self->poderror({ -line => $line, -file => $file,
  976.                      -severity => 'ERROR', 
  977.                      -msg => "Nested =begin's (first at line " .
  978.                      $self->{_have_begin} . ")"});
  979.             }
  980.             else {
  981.                 # check for argument
  982.                 $arg = $self->interpolate_and_check($paragraph, $line,$file);
  983.                 unless($arg && $arg =~ /(\S+)/) {
  984.                     $self->poderror({ -line => $line, -file => $file,
  985.                          -severity => 'ERROR', 
  986.                          -msg => "No argument for =begin"});
  987.                 }
  988.                 # remember the =begin
  989.                 $self->{_have_begin} = "$line:$1";
  990.             }
  991.         }
  992.         elsif($cmd eq 'end') {
  993.             if($self->{_have_begin}) {
  994.                 # close the existing =begin
  995.                 $self->{_have_begin} = '';
  996.                 # check for spurious characters
  997.                 $arg = $self->interpolate_and_check($paragraph, $line,$file);
  998.                 # the closing argument is optional
  999.                 #if($arg && $arg =~ /\S/) {
  1000.                 #    $self->poderror({ -line => $line, -file => $file,
  1001.                 #         -severity => 'WARNING', 
  1002.                 #         -msg => "Spurious character(s) after =end" });
  1003.                 #}
  1004.             }
  1005.             else {
  1006.                 # don't have a matching =begin
  1007.                 $self->poderror({ -line => $line, -file => $file,
  1008.                      -severity => 'ERROR', 
  1009.                      -msg => "=end without =begin" });
  1010.             }
  1011.         }
  1012.         elsif($cmd eq 'for') {
  1013.             unless($paragraph =~ /\s*(\S+)\s*/) {
  1014.                 $self->poderror({ -line => $line, -file => $file,
  1015.                      -severity => 'ERROR', 
  1016.                      -msg => "=for without formatter specification" });
  1017.             }
  1018.             $arg = ''; # do not expand paragraph below
  1019.         }
  1020.         elsif($cmd =~ /^(pod|cut)$/) {
  1021.             # check for argument
  1022.             $arg = $self->interpolate_and_check($paragraph, $line,$file);
  1023.             if($arg && $arg =~ /(\S+)/) {
  1024.                 $self->poderror({ -line => $line, -file => $file,
  1025.                       -severity => 'ERROR', 
  1026.                       -msg => "Spurious text after =$cmd"});
  1027.             }
  1028.         }
  1029.     $self->{_commands_in_head}++;
  1030.     ## Check the interior sequences in the command-text
  1031.     $self->interpolate_and_check($paragraph, $line,$file)
  1032.         unless(defined $arg);
  1033.     }
  1034. }
  1035.  
  1036. sub _open_list
  1037. {
  1038.     my ($self,$indent,$line,$file) = @_;
  1039.     my $list = Pod::List->new(
  1040.            -indent => $indent,
  1041.            -start => $line,
  1042.            -file => $file);
  1043.     unshift(@{$self->{_list_stack}}, $list);
  1044.     undef $self->{_list_item_contents};
  1045.     $list;
  1046. }
  1047.  
  1048. sub _close_list
  1049. {
  1050.     my ($self,$line,$file) = @_;
  1051.     my $list = shift(@{$self->{_list_stack}});
  1052.     if(defined $self->{_list_item_contents} &&
  1053.       $self->{_list_item_contents} == 0) {
  1054.         $self->poderror({ -line => $line, -file => $file,
  1055.             -severity => 'WARNING', 
  1056.             -msg => "previous =item has no contents" });
  1057.     }
  1058.     undef $self->{_list_item_contents};
  1059.     $list;
  1060. }
  1061.  
  1062. # process a block of some text
  1063. sub interpolate_and_check {
  1064.     my ($self, $paragraph, $line, $file) = @_;
  1065.     ## Check the interior sequences in the command-text
  1066.     # and return the text
  1067.     $self->_check_ptree(
  1068.         $self->parse_text($paragraph,$line), $line, $file, '');
  1069. }
  1070.  
  1071. sub _check_ptree {
  1072.     my ($self,$ptree,$line,$file,$nestlist) = @_;
  1073.     local($_);
  1074.     my $text = '';
  1075.     # process each node in the parse tree
  1076.     foreach(@$ptree) {
  1077.         # regular text chunk
  1078.         unless(ref) {
  1079.             # count the unescaped angle brackets
  1080.             # complain only when warning level is greater than 1
  1081.             if($self->{-warnings} && $self->{-warnings}>1) {
  1082.               my $count;
  1083.               if($count = tr/<>/<>/) {
  1084.                 $self->poderror({ -line => $line, -file => $file,
  1085.                      -severity => 'WARNING', 
  1086.                      -msg => "$count unescaped <> in paragraph" });
  1087.                 }
  1088.             }
  1089.             $text .= $_;
  1090.             next;
  1091.         }
  1092.         # have an interior sequence
  1093.         my $cmd = $_->cmd_name();
  1094.         my $contents = $_->parse_tree();
  1095.         ($file,$line) = $_->file_line();
  1096.         # check for valid tag
  1097.         if (! $VALID_SEQUENCES{$cmd}) {
  1098.             $self->poderror({ -line => $line, -file => $file,
  1099.                  -severity => 'ERROR', 
  1100.                  -msg => qq(Unknown interior-sequence '$cmd')});
  1101.             # expand it anyway
  1102.             $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
  1103.             next;
  1104.         }
  1105.         if($nestlist =~ /$cmd/) {
  1106.             $self->poderror({ -line => $line, -file => $file,
  1107.                  -severity => 'WARNING', 
  1108.                  -msg => "nested commands $cmd<...$cmd<...>...>"});
  1109.             # _TODO_ should we add the contents anyway?
  1110.             # expand it anyway, see below
  1111.         }
  1112.         if($cmd eq 'E') {
  1113.             # preserve entities
  1114.             if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {
  1115.                 $self->poderror({ -line => $line, -file => $file,
  1116.                     -severity => 'ERROR', 
  1117.                     -msg => "garbled entity " . $_->raw_text()});
  1118.                 next;
  1119.             }
  1120.             my $ent = $$contents[0];
  1121.             my $val;
  1122.             if($ent =~ /^0x[0-9a-f]+$/i) {
  1123.                 # hexadec entity
  1124.                 $val = hex($ent);
  1125.             }
  1126.             elsif($ent =~ /^0\d+$/) {
  1127.                 # octal
  1128.                 $val = oct($ent);
  1129.             }
  1130.             elsif($ent =~ /^\d+$/) {
  1131.                 # numeric entity
  1132.                 $val = $ent;
  1133.             }
  1134.             if(defined $val) {
  1135.                 if($val>0 && $val<256) {
  1136.                     $text .= chr($val);
  1137.                 }
  1138.                 else {
  1139.                     $self->poderror({ -line => $line, -file => $file,
  1140.                         -severity => 'ERROR', 
  1141.                         -msg => "Entity number out of range " . $_->raw_text()});
  1142.                 }
  1143.             }
  1144.             elsif($ENTITIES{$ent}) {
  1145.                 # known ISO entity
  1146.                 $text .= $ENTITIES{$ent};
  1147.             }
  1148.             else {
  1149.                 $self->poderror({ -line => $line, -file => $file,
  1150.                     -severity => 'WARNING', 
  1151.                     -msg => "Unknown entity " . $_->raw_text()});
  1152.                 $text .= "E<$ent>";
  1153.             }
  1154.         }
  1155.         elsif($cmd eq 'L') {
  1156.             # try to parse the hyperlink
  1157.             my $link = Pod::Hyperlink->new($contents->raw_text());
  1158.             unless(defined $link) {
  1159.                 $self->poderror({ -line => $line, -file => $file,
  1160.                     -severity => 'ERROR', 
  1161.                     -msg => "malformed link " . $_->raw_text() ." : $@"});
  1162.                 next;
  1163.             }
  1164.             $link->line($line); # remember line
  1165.             if($self->{-warnings}) {
  1166.                 foreach my $w ($link->warning()) {
  1167.                     $self->poderror({ -line => $line, -file => $file,
  1168.                         -severity => 'WARNING', 
  1169.                         -msg => $w });
  1170.                 }
  1171.             }
  1172.             # check the link text
  1173.             $text .= $self->_check_ptree($self->parse_text($link->text(),
  1174.                 $line), $line, $file, "$nestlist$cmd");
  1175.             # remember link
  1176.             $self->hyperlink([$line,$link]);
  1177.         }
  1178.         elsif($cmd =~ /[BCFIS]/) {
  1179.             # add the guts
  1180.             $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
  1181.         }
  1182.         elsif($cmd eq 'Z') {
  1183.             if(length($contents->raw_text())) {
  1184.                 $self->poderror({ -line => $line, -file => $file,
  1185.                     -severity => 'ERROR', 
  1186.                     -msg => "Nonempty Z<>"});
  1187.             }
  1188.         }
  1189.         elsif($cmd eq 'X') {
  1190.             my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
  1191.             if($idx =~ /^\s*$/s) {
  1192.                 $self->poderror({ -line => $line, -file => $file,
  1193.                     -severity => 'ERROR', 
  1194.                     -msg => "Empty X<>"});
  1195.             }
  1196.             else {
  1197.                 # remember this node
  1198.                 $self->idx($idx);
  1199.             }
  1200.         }
  1201.         else {
  1202.             # not reached
  1203.             die "internal error";
  1204.         }
  1205.     }
  1206.     $text;
  1207. }
  1208.  
  1209. # process a block of verbatim text
  1210. sub verbatim { 
  1211.     ## Nothing particular to check
  1212.     my ($self, $paragraph, $line_num, $pod_para) = @_;
  1213.  
  1214.     $self->_preproc_par($paragraph);
  1215.  
  1216.     if($self->{_current_head1} eq 'NAME') {
  1217.         my ($file, $line) = $pod_para->file_line;
  1218.         $self->poderror({ -line => $line, -file => $file,
  1219.             -severity => 'WARNING',
  1220.             -msg => 'Verbatim paragraph in NAME section' });
  1221.     }
  1222. }
  1223.  
  1224. # process a block of regular text
  1225. sub textblock { 
  1226.     my ($self, $paragraph, $line_num, $pod_para) = @_;
  1227.     my ($file, $line) = $pod_para->file_line;
  1228.  
  1229.     $self->_preproc_par($paragraph);
  1230.  
  1231.     # skip this paragraph if in a =begin block
  1232.     unless($self->{_have_begin}) {
  1233.         my $block = $self->interpolate_and_check($paragraph, $line,$file);
  1234.         if($self->{_current_head1} eq 'NAME') {
  1235.             if($block =~ /^\s*(\S+?)\s*[,-]/) {
  1236.                 # this is the canonical name
  1237.                 $self->{-name} = $1 unless(defined $self->{-name});
  1238.             }
  1239.         }
  1240.     }
  1241. }
  1242.  
  1243. sub _preproc_par
  1244. {
  1245.     my $self = shift;
  1246.     $_[0] =~ s/[\s\n]+$//;
  1247.     if($_[0]) {
  1248.         $self->{_commands_in_head}++;
  1249.         $self->{_list_item_contents}++ if(defined $self->{_list_item_contents});
  1250.         if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) {
  1251.             $self->{_list_stack}->[0]->{_has_par} = 1;
  1252.         }
  1253.     }
  1254. }
  1255.  
  1256. 1;
  1257.  
  1258. __END__
  1259.  
  1260. =head1 AUTHOR
  1261.  
  1262. Please report bugs using L<http://rt.cpan.org>.
  1263.  
  1264. Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
  1265. Marek Rouchal E<lt>marekr@cpan.orgE<gt>
  1266.  
  1267. Based on code for B<Pod::Text::pod2text()> written by
  1268. Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
  1269.  
  1270. =cut
  1271.  
  1272.